Aminet 12

home *** CD-ROM | disk | FTP | other *** search

/ Aminet 12 / Aminet 12 (1996)(GTI - Schatztruhe)[!][Jun 1996].iso / Aminet / dev / lang / HeliOS3.lha / helios_demo_disk3 / source / Fonts_Demo.src < prev next >

Wrap

Text File | 1996-02-26 | 18.6 KB | 723 lines

\ *********************************************************** \ \ FONTS DEMO \ \ *********************************************************** \ \ This code demonstrates how to display text in various fonts \ using both standard Amiga fonts and HeliOS colour bitmap fonts. \ \ The demo shows how both these types of font may be used in \ HeliOS "Game Mode" or under the Amiga operating system. \ \ First the production of text using both types of fonts is \ demonstrated under the Amiga operating system. \ \ An IFF file is then loaded and displayed under the HeliOS \ Game operating system, after which text using the various \ fonts is displayed once more. \ \ *********************************************************** \ *********************************************************** \ Re-initialise HeliOS dictionary to standard CORE vocabulary \ *********************************************************** \ This should always be used at the start of any program which \ is to be repeatedly recompiled. FORGET **CORE** \ ************************* \ Load include symbol files \ ************************* \ \ These "include files" are pre-compiled (for speed) versions of the \ Amiga includes and the Helios system includes. \ \ Uncomment the lines below for standalone compilation, but otherwise \ it is better to set these include files from the Helios Forth menus AMIGAINCLUDE HeliOS:HeliOS_AmigaInclude USERINCLUDE HeliOS:HeliOS_UserInclude \ *************************************** \ Create display imagery file name string \ *************************************** \ This file is an ordinary IFF (and may be "PowerPacked" if required) \ \ The picture here will be loaded into the display BitMap. \ $CONSTANTL Slice1Pic $HeliOS:Source/Data/Pic2$ \ **************************************************** \ Create colour font and texture map file name strings \ **************************************************** \ These files are ordinary IFFs (and may be "PowerPacked" if required) \ $CONSTANTL ColourFontPic $HeliOS:Source/Data/ColourFont16*16$ $CONSTANTL TextureMapPic $HeliOS:Source/Data/FontTextureMap$ \ ************************************** \ Create display configuration constants \ ************************************** \ \ Collect all "display-specific" parameters here and generate "named" \ constants which make references easier than using numeric values. \ \ Collecting these together here makes it easier to adjust things at any \ time without having to search source code to replace values individually. \ 256 CONSTANT DisplayHeight \ Full PAL display 320 CONSTANT DisplayWidth \ Lores display 44 CONSTANT DisplayTopLine \ Display start DisplayWidth CONSTANT Slice1Width \ Lores width DisplayWidth 32 + CONSTANT Slice1RasterWidth \ Raster=SWidth+32 DisplayHeight CONSTANT Slice1Height \ Slice height DisplayHeight 32 + CONSTANT Slice1RasterHeight \ Slice Raster=DHgt+32 0 CONSTANT Slice1Mode \ Lores 3 CONSTANT Slice1Planes \ Slice bitplanes \ The calculation below takes the number of bitplanes and calculates \ how many colours this represents. \ \ One bitplane gives two colours. \ \ Each additional bitplane multiplies the number of colours by two. \ \ Performing a single LSL operation on any number multipies by 2, so we \ have a quick method of multiplying by two for our colour calculation. \ \ In this case, we need "2 to the power 3", which is 2*2*2=8. \ \ e.g. 2*2*2 \ ^ ^ ^ \ Total number of planes = 3 \ \ \ So, we take the first value two \ \ e.g. 2*2*2 \ ^ \ Initial start value of 2 \ \ and we now need to multiply it by two "the_number_of_planes minus_one" \ more times. \ \ e.g. 2*2*2 \ ^ ^ \ Total planes minus one \ \ \ So, Number of colours = 2 operated on by LSL NumberOfPlanes-1 times. \ 2 Slice1Planes 1- LSL CONSTANT Slice1Colours \ A-slice colours \ *********************** \ Error handling routines \ *********************** \ This error handler allows all errors to be routed via a comprehensive \ sequential closedown routine, which is associated with the HeliOS \ system error handler word ERROR". \ \ When ERROR" senses an error, it prints an associated error message \ delimited by '"' characters, and then closes everything down using the \ routine CLOSEDOWN below which you have supplied. \ \ This simplifies errors checks to the use of a single word, ERROR", which \ displays a text message and closes eveything down. \ 0 VARIABLE (CLOSEDOWN) : ?CLOSEDOWNERROR IF CR CR TYPE CR CR ." Press <Space> to quit!" CR CR WAITSPACE (CLOSEDOWN) @EXECUTE QUIT ELSE DDROP THEN ; LATESTCFA VARIABLE ERROR1 \ **************************************** \ Create display pointer storage variables \ **************************************** \ Here we create a set of "pointers", initially set to a "null" value. \ \ These "pointers" are set up as "long addresses" when various components \ of the display system are allocated and initialised. \ \ Note that initially these are all set to zero, and we clear them back \ to zero when we de-allocate the associated resource. \ \ These DPOINTERs are all initially set to "null" by using '0.'. \ \ When we allocate memory or Amiga system resources in the program at \ run-time, these pointers are updated to contain the 32-bit address \ of the newly allocated resource. \ \ Subsequently the symbolic DPOINTER name can be used in your code to \ represent the associated address. 0. DPOINTER Display1 \ Main Display structure pointer 0. DPOINTER Slice1 \ Slice 1 Slice structure pointer 0. DPOINTER Slice1_ColorMap \ Slice 1 ColourMap structure pointer 0. DPOINTER Slice1_RasInfo \ Slice 1 RasInfo structure pointer 0. DPOINTER Slice1_BMap \ Slice 1 BitMap structure pointer 0. DPOINTER Slice1_RPort \ Slice 1 RastPort structure pointer 0. DPOINTER Slice1_SliceControl \ Slice 1 SliceControl structure pointer \ ************* \ Colour tables \ ************* \ Each colour entry requies 2 bytes of storage space CREATEL Slice1_ColorTable \ Create longword pointer to table Slice1Colours 2* 0 ALLOTFILL \ Allocate Slice1 colours * 2 bytes \ *********************************** \ Create Display and Slice structures \ *********************************** \ This routine simply makes blank structures, which then need to be \ initialised later (in the CREATE_DISPLAY routine). : CREATE_DSLICES DS_SIZEOF MAKESTRUCTURE Display1 MAKEPOINTER \ Main "Display" structure SL_SIZEOF MAKESTRUCTURE Slice1 MAKEPOINTER \ Display "Slice" structure ; : FREE_DSLICES Slice1 DDUP FREEMEMORY CLEARPOINTER Display1 DDUP FREEMEMORY CLEARPOINTER ; \ ****************************** \ Create RasInfo structures etc. \ ****************************** : CREATE_RASINFO \ First allocate and initialise complete RasInfo structures. \ \ This routine automatically allocates all BitMaps etc. \ Slice1RasterWidth Slice1RasterHeight Slice1Planes OPENRASINFO DFLAG0= ERROR" Fail: RasInfo1" Slice1_RasInfo MAKEPOINTER \ Set invisible area "sprite margins" for slice RasInfo 16 Slice1_RasInfo ri_RxOffset INDEX!L 16 Slice1_RasInfo ri_RyOffset INDEX!L \ Store BitMap pointer - often useful for later reference Slice1_RasInfo ri_BitMap INDEXD@L Slice1_BMap MAKEPOINTER Slice1_BMap 0 MakeRPort DFLAG0= ERROR" Fail: RastPort" Slice1_RPort MAKEPOINTER ; : FREE_RASINFO Slice1_RPort CLOSERPORT Slice1_RasInfo DDUP CLOSERASINFO CLEARPOINTER ; \ ******************************** \ Create Display/Slice Copperlists \ ******************************** \ This function builds the main display copperlist by: \ \ 1. Initialising the Slice data structure \ 2. Calling MAKECOPSTRIP for the slice, to build a copperlist \ 3. Calling MAKEDISPLAY to build the master Display copperlist \ : CREATE_DISPLAY \ First initialise main display structures Slice1 Display1 DS_Slice INDEXD!L Slice1Width Slice1 SL_DWidth INDEX!L Slice1Height Slice1 SL_DHeight INDEX!L DisplayTopLine Slice1 SL_DyOffset INDEX!L Slice1_RasInfo Slice1 SL_RasInfo INDEXD!L Slice1_ColorMap Slice1 SL_ColorMap INDEXD!L Slice1Mode Slice1 SL_Modes INDEX!L \ Generate copper list information for each of the display slices Slice1 MAKECOPSTRIP D0= ERROR" Fail: Slice1CopStrip" \ Make display Display1 MAKEDISPLAY D0= ERROR" Fail: Display1" ; : FREE_DISPLAY Display1 FREEDISPLAY Slice1 FREECOPSTRIP ; \ ******************************************************** \ Create SliceControl structures for double buffered slice \ ******************************************************** \ SliceControl structures are used to control any slices which perform \ mapping or scrolling functions, or which require double or triple \ playfield buffering. \ \ In this case we have one slice which does not scroll, is not mapped, \ but IS double buffered. \ : CREATE_SLICECONTROL \ Make SliceControl for single buffered bitmap display Slice1 Slice1Width Negate Slice1Height Negate MAKESLICECONTROL DFLAG0= ERROR" Fail: SliceControl1" Slice1_SliceControl MAKEPOINTER \ Install slice controls into HeliOS display control system Slice1_SliceControl INSTALLSLICECONTROL ; : FREE_SLICECONTROL CLEARSLICECONTROLS Slice1_SliceControl CLOSESLICECONTROL ; \ These routines load an IFF picture into supplied BitMap, and correctly \ initialises the supplied ColorTable. \ \ The ColorTable is then used to create an initialised ColorMap structure. \ : CREATE_IMAGERY Slice1_BMap Slice1_ColorTable Slice1Pic 10 2 DOSLIB \ Call to internal HeliOS library 10 <> ERROR" Fail: Slice1Pic" Slice1_ColorTable Slice1Colours MAKECOLORMAP \ Allocate ColourMap DFLAG0= ERROR" Fail: Slice1ColorMap" Slice1_ColorMap MAKEPOINTER ; : FREE_IMAGERY Slice1_ColorMap DDUP FREECOLORMAP CLEARPOINTER ; \ --------------------------------------------------------------------------- \ Fonts Demo Code \ --------------------------------------------------------------------------- 0. DVARIABLE DiskFontBase 0. DVARIABLE Topaz8Font 0. DVARIABLE Ruby8Font 0. DVARIABLE Ruby12Font 0. DVARIABLE Ruby15Font 0. DPOINTER TextureMap_BMap \ Texture BitMap pointer 0. DPOINTER ColourFont_BMap \ Font BitMap pointer 0. DPOINTER ColourFont_Mask_BMap \ Mask BitMap pointer $CONSTANT DiskFont$ $diskfont.library$ \ Diskfont library name CREATEL FontName <$ ruby.font$ \ New font name CREATEL TopazName <$ topaz.font$ \ Topaz font name CREATEL Topaz8 \ Create Textattr Structure TopazName D, 8 , 0 C, \ Normal 0 C, \ In ROM CREATEL Ruby8 \ Create Textattr Structure FontName D, 9 , 0 C, \ Normal 2 C, \ From Disk CREATEL Ruby12 \ Create Textattr Structure FontName D, 11 , 2 C, \ Bold 2 C, \ From Disk CREATEL Ruby15 \ Create Textattr Structure FontName D, 15 , 2 C, \ Bold 2 C, \ From Disk : SetFont \ a1 - - - D@ 0 AREG D! \ Set New Font Into Window 1 AREG D! GFXBASE -66 LIBRARY ; \ *************************************************************** \ This font definition will be used for texture mapped colourfont \ *************************************************************** CREATEL TextureFontDef 0. D, 0. D, 16 , 16 , 100 , 1 , \ ********************************************************* \ This font definition will be used for standard colourfont \ ********************************************************* CREATEL ColourFontDef 0. D, 0. D, 16 , 16 , 100 , 1 , : OPEN_FONTS \ Load font texture map imagery and prepare textured font definition TextureMapPic 2 3 DOSLIB 2 <> IF 1 ERROR" Fail: TextureMapPic" THEN DDUP TextureMap_BMap MAKEPOINTER TextureFontDef D!L \ Load colour font imagery and prepare standard font definition ColourFontPic 2 3 DOSLIB 2 <> IF 1 ERROR" Fail: ColourFontPic" THEN DDUP ColourFont_BMap MAKEPOINTER ColourFontDef D!L \ Generate font mask from font imagery bitmap ColourFont_BMap GETMASK DFLAG0= ERROR" Fail: ColourFontMask" DTRIP ColourFont_Mask_BMap MAKEPOINTER \ Install font mask in both font definitions TextureFontDef 4. D+ D!L ColourFontDef 4. D+ D!L \ Set up standard Amiga fonts DiskFont$ 0 OPENLIB DFLAG0= ERROR" Fail: DiskFont Library" DiskFontBase D! Topaz8 0 AREG D! DiskFontBase -30 LIBRARY D0RESULT DFLAG0= ERROR" Fail: Topaz8 Font" Topaz8Font D! Ruby8 0 AREG D! DiskFontBase -30 LIBRARY D0RESULT DFLAG0= ERROR" Fail: Ruby8 Font" Ruby8Font D! Ruby12 0 AREG D! DiskFontBase -30 LIBRARY D0RESULT DFLAG0= ERROR" Fail: Ruby12 Font" Ruby12Font D! Ruby15 0 AREG D! DiskFontBase -30 LIBRARY D0RESULT DFLAG0= ERROR" Fail: Ruby15 Font" Ruby15Font D! ; : CLOSE_FONTS Ruby8Font D@ 1 AREG D! GFXBASE -78 LIBRARY Ruby12Font D@ 1 AREG D! GFXBASE -78 LIBRARY Ruby15Font D@ 1 AREG D! GFXBASE -78 LIBRARY Topaz8Font D@ 1 AREG D! GFXBASE -78 LIBRARY DiskFontBase D@ CLOSELIB 0. SETHELIOSFONT ColourFont_Mask_BMap DDUP CLOSEBMAP CLEARPOINTER ColourFont_BMap DDUP CLOSEBMAP CLEARPOINTER TextureMap_BMap DDUP CLOSEBMAP CLEARPOINTER ; \ ********************* \ Close down everything \ ********************* : CLOSEDOWN FREE_SLICECONTROL FREE_DISPLAY FREE_IMAGERY FREE_RASINFO FREE_DSLICES CLOSE_FONTS RESETERROR" ; LATESTCFA (CLOSEDOWN) ! : TestDisplay \ Start of program SCRCLR CR ." **********************************************************" CR 6 FPENSET ." FONTS DEMO" CR 1 FPENSET ." **********************************************************" CR CR ." This code demonstrates how to display text in various fonts" CR ." using both standard Amiga fonts and HeliOS colour bitmap fonts." CR CR ." The demo shows how both these types of font may be used in" CR .$ HeliOS "Game Mode" or under the Amiga operating system.$ CR CR ." First the production of text using both types of fonts is" CR ." demonstrated under the Amiga operating system." CR CR ." An IFF file is then loaded and displayed under the HeliOS" CR ." Game operating system, after which text using the various" CR ." fonts is displayed once more." CR CR ." **********************************************************" CR 6 FPENSET ." Press <Space> or <L-Mouse> to see Demo " CR 1 FPENSET ." **********************************************************" CR WAITSPACE SCRCLR ERROR1 SETERROR" \ Redirect system errors to our routine ERROR1 OPEN_FONTS CREATE_DSLICES CREATE_RASINFO CREATE_IMAGERY CREATE_DISPLAY CREATE_SLICECONTROL 100 100 GFXMOVE FRPORT Ruby8Font SetFont LIT$ This is text in Ruby 8 font$ COUNT GFXTEXT 100 120 GFXMOVE FRPORT Ruby12Font SetFont LIT$ This is text in Ruby 12 Bold font$ COUNT GFXTEXT 100 140 GFXMOVE FRPORT Ruby15Font SetFont LIT$ This is text in Ruby 15 Bold font$ COUNT GFXTEXT 100 160 GFXMOVE FRPORT Topaz8Font SetFont LIT$ This is text in Topaz8 font$ COUNT GFXTEXT \ ******************************************* \ Render text using texture mapped colourfont \ ******************************************* TextureFontDef SETHELIOSFONT 100 180 GFXMOVE FRPORT LIT$L Textured ColourFont$ COUNTL DROP HELIOSRPTEXT \ ************************************* \ Render text using standard colourfont \ ************************************* ColourFontDef SETHELIOSFONT FBMAP LIT$L Standard ColourFont$ COUNTL DROP 100 200 0 0 HELIOSBMTEXT WAITSPACE SCRCLR 0. Slice1_RPort MAKEGFXRPORT HeliOS_On 1 FrameRate !L Display1 SHOWDISPLAY 1 GFXSETAPEN 35 100 GFXMOVE Slice1_RPort Ruby8Font SetFont LIT$ This is Ruby 8$ COUNT GFXTEXT 35 120 GFXMOVE Slice1_RPort Ruby12Font SetFont LIT$ This is Ruby 12 Bold$ COUNT GFXTEXT 35 140 GFXMOVE Slice1_RPort Ruby15Font SetFont LIT$ This is Ruby 15 Bold$ COUNT GFXTEXT 35 160 GFXMOVE Slice1_RPort Topaz8Font SetFont LIT$ This is Topaz8$ COUNT GFXTEXT \ ******************************************* \ Render text using texture mapped colourfont \ ******************************************* TextureFontDef SETHELIOSFONT 25 180 GFXMOVE Slice1_RPort LIT$L Textured ColourFont$ COUNTL DROP HELIOSRPTEXT \ ************************************* \ Render text using standard colourfont \ ************************************* ColourFontDef SETHELIOSFONT Slice1_RPort rp_BitMap INDEXD@L LIT$L Standard ColourFont$ COUNTL DROP 25 200 0 0 HELIOSBMTEXT WAITSPACE HeliOS_Off FSCREEN FRPORT MAKEGFXRPORT CLOSEDOWN ; TestDisplay \ ***************************************************************** \ End \ *****************************************************************